perm filename DRAW2.OLD[DRW,LCS] blob sn#449477 filedate 1979-06-10 generic text, type T, neo UTF8
C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C***    DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
C***    ,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
C***    ,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]

C  'G' OR <CR> = GET.  'A'=ADD TO COMBINED FILE.
C PC=PLOT  PX=XGP(→PLOT.BIN)  PXS,PCS=PLOT SMOOTHED CONTURE
C  PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
C  F=JUMP AND BEGIN FILL SECTION.  FX=EXIT AND FILL ALL.
C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
	COMMON /RC/MCLEF(400),IST(4000)
	COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
	COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
	COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
	DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
	COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
	COMMON/LETS/LETS(12)
	EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
	1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
	2 ,(NMLST,IST(1510)),(JST,IST(500))
	3,(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4),LD)
	4,(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
	5,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LQ),(LETS(12),LC)
	DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
	1'Q','C'/
	DATA RJB/-20./,CENTR/-26./
	RSZ=0
10	MCLEF(1)=0
	MM=0
	IPLT=0
	IPLTX=-1
	K=1
20	TYPE 490
30	FORMAT(I,2F)
40	FORMAT(3A1)
	XSZ=RSZ
	ACCEPT 30,J,RSZ,GRID
	IF(RSZ.EQ.0)RSZ=XSZ
	MORE=-1
	REREAD 40,N,JC,JS
	IF(RSZ.EQ.0)RSZ=9.0
	IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
	DO 50 K=1,12
C                             G  S  M  D  R  P  A  F  E  Z
50	IF(LETS(K).EQ.N)GO TO(140,140,120,80,120,140,110,390,90,10,
	1 100)K
C         Q
	IF(N.NE.' ')TYPE 60
	GO TO 40
60	FORMAT(' UNKNOWN COMMAND'/)
C PXS,PCS=SMOOTH ONLY;  PXZ,PCZ=SMOOTH AND FILL
C  TO SAVE SIZE FACTOR WHEN REDRAWING.
70	IF(N.EQ.'V')CALL CNVT
C  V=CONVERT FROM OLD FORMAT TO NEW.
C  FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
C  FILLS IT.
C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2

80	IF(JS.NE.'L')GO TO 90
	N='Z'
C  DEL=DELETE FROM COMB. FILE.   (JS='L')
	GO TO 110
90	KED=N
	MM=MCLEF(1)
	IF(MM.NE.0)GO TO 500
C  ADD TO DRAWING?
	GO TO 330

100	CALL POG2
	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL DPYOUT(2)
	CALL POG1
	GO TO 20
110	CALL CMBN
CCC     GO TO 111
	GO TO 20
120	CALL SHIFT(MCLEF(2),MCLEF(1),N)
	J=1
	JC=0
	GO TO 340
130	FORMAT(A2,A5)
140	REREAD 130,NM,NM
	IF(JC.EQ.LM)NM=' '
	IF(NM.NE.' ')GO TO 180
150	TYPE 520
	IF(JC.EQ.'M')GO TO 160
	IF(N.EQ.'S')GO TO 160
	MCLEF(1)=0
	MM=0
	IPLTX=-1
	K=1
160	IF(JC.EQ.'M')MORE=0
	JQ=JC
	JC=0
	JM=1
	IF(MCLEF(1).EQ.0)GO TO 170
	JM=MCLEF(1)+1
170	ACCEPT 470,NM,PASS
	IF(NM.EQ.' ')NM=LASTNM
	IF(NM.EQ.' ')GO TO 20
	IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 20
C  'B' OR '99'  WILL BACKUP
180	IF(N.NE.'S')LASTNM=NM
	IF(N.EQ.'S')GO TO 530
	IF(LOOKF(NM).EQ.0)GO TO  150
C  'FAIL' ROUTINE TO CHECK ON LOOKUP
	CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
C  -1=READ
C  CAN'T USE 'GM' WITH 'COMBINED' FILE.
	J=1
	IF(KCLEF(2).EQ.0)GO TO 190
	TYPE 230
	ACCEPT 30,J
	J=J+1
C  ITEMS ARE NUMBERED  0 THROUGH 9 (10 ITEMS).
	IF(J.GT.10)GO TO 50
190	IC=KCLEF(J)+JST(KCLEF(J))-1
CCC     TYPE 110,IC
	IF(IC.GT.350)TYPE 570
200	JZ=1
	IF(MORE.EQ.0)JZ=JM
	L=KCLEF(J)-1
	M=JST(L+1)+JZ-1
	IF(MORE.NE.0)GO TO 210
	M=M-1
	L=L+1
210	DO 220 K=JZ,M
	L=L+1
220	MCLEF(K)=JST(L)
	MCLEF(1)=M
230	FORMAT(' ITEM NUM?'/)
240	FORMAT(' RESET X-Y POS. ',$)
250	FORMAT(2F)
260	IF(MORE)GO TO 320
	DO 270 K=2,JM-1
270	IF(MCLEF(K).GE.200000000)GO TO 280
	GO TO 320
C PUTS FILLER TO END
C  MOVES OUTLINE UP FRONT
280	M=MCLEF(1)
	DO 290 L=K,JM
	M=M+1
290	MCLEF(M)=MCLEF(L)
	K=JM-K
300	DO 310 L=JM,M
310	MCLEF(L-K)=MCLEF(L)
	GO TO 330

320	IF(N.NE.'P')GO TO 330
	IXRX=-1
	IF(JQ.NE.'X')IXRX=0
C 0=SEND IT TO CALCOMP
	TYPE 240
	ACCEPT 250,X,Y
	IF(X.NE.0)RJB=X/RSZ
	IF(Y.NE.0)CENTR=Y/RSZ
C  TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
	IF(IPLTX)CALL PLOTS(0)
C  DO I NEED THIS?
	IF(GRID.GT.0)CALL GRIDS
	IPLTX=0
	IPLT=-1
330	IF(N.NE.'D')MM=0
C  RESET IF NOT GOING TO DRAWIT
340	IF(N.EQ.'P')GO TO 350
	CALL DPYSET(1,IST,4000)
	CALL DPYBRT(4)
	NIST=IST(2)
	IF(N.GE.0)GO TO 350
	IF(N.EQ.'G')GO TO 350
	IF(N.EQ.'M')GO TO 350
	IF(N.NE.'R')GO TO 500
350	IF(JS.EQ.'Z')GO TO 400
	IF(JS.NE.'S')GO TO 360
	CALL SMOOTH(JS)
	GO TO 430
360	IC=-1
	MM=1
	DO 370 K=2,MCLEF(1)
	IF(MCLEF(K).LT.200000000)GO TO 370
	IC=K
	GO TO 380
C FOR 1ST LOC. OF MCLEF IN FILLER
370	CONTINUE
380	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL DPYOUT(1)
	NIST=IST(2)
	GO TO 430
C NO FILLER
390	IF(IC)GO TO 20
C  IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
	JZ=N
	KK=0
	IF(JC.NE.'S')GO TO 410
C  TYPE 'FS' TO FILL AND SMOOTH
400	CALL SMOOTH(0)
C  SMOOTHS AND FILLS
	GO TO 430
410	RR=RSZ
	DO 420 J=IC,MCLEF(1)
	CALL UNPACK(J,M,N,MCLEF)
	KK=KK+1
	NF(KK)=0
	IF(LL.GE.100000000)NF(KK)=3
	QF(KK)=(M+RJB)*RR
420	RF(KK)=(N+CENTR)*RR
	NF(1)=KK
	CALL FILLQ(QF,RF,NF)
430	IF(JZ.EQ.'P')CALL PLOT(0,0,3)
	GO TO 20

440	TYPE 450,NM
	GO TO 20
450	FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
460	FORMAT(' SMOOTH? ',$)
470	FORMAT(A5,F)
480	FORMAT(12I)
490	FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
	1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
	2, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
	3' F=FILL,  E=EDIT,   N1=SIZE, N2=1=GRID '/)
C  N1=20 TO CHANGE SHAPE

500	IST(2)=NIST
	CALL DRAWIT
	N=0
	GO TO 330

510	FORMAT(' WRITE OVER ',A5,'.DMD?  ',$)
520	FORMAT(' TYPE FILE NAME'/)
C  SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
530	IF(LOOKF(NM).EQ.0)GO TO 540
	TYPE 510,NM
	ACCEPT 40,K
	IF(K.EQ.'N')GO TO 50
540	NMLST(1)=NM
	JCLEF(1)=1
	DO 550 K=2,10
	JCLEF(K)=0
550	NMLST(K)=' '
	CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
	NQ=MCLEF(1)
CC111   TYPE 110,NQ
	IF(NQ.GT.350)TYPE 570
	GO TO 20
CC120   FORMAT(' 9999  1 ',I4,' 0 0 0 0 0 0 0 0')
560	FORMAT(' TOTAL WDS=',I3)
570	FORMAT(' ********************************',/
	1      ' ***** WARNING - LIMIT=350 ******',/
	2      ' ********************************')
	END
	SUBROUTINE CMBN
	COMMON /RC/MCLEF(400),IST(4000)
	COMMON /FL/NX,N,L,M,NM,J,NT
	DIMENSION IP(10),NMS(10),NF(2500),JP(10),NMX(10)
	EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
	1,(JP,IST(1500)),(NMX,IST(1510))
C *****   ******   ****   ******              ↑ 20 FOR OVERRUN IN IP(11)
C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
	IF(N.EQ.'S')GO TO 170
10	TYPE 20
20	FORMAT(' TYPE OUTPUT FILE NAME ',$)
30	FORMAT(A5)
	DO 40 K=1,10
	IP(K)=0
40	NMS(K)=' '
	ACCEPT 30,NM
	IF(NM.NE.' ')GO TO 50
	NM=LASTNM
	TYPE 180,LASTNM
50	LASTNM=NM
	IF(LOOKF(NM).EQ.0)GO TO 60
	IF(N.NE.'C')GO TO 170
C  FOR ADDING TO COMBINED FILE.
	TYPE 120,NM
	ACCEPT 30,NX
	IF(NX.EQ.'N')GO TO 10
60	IF(N.EQ.'C')GO TO 70
	TYPE 100
	GO TO 10
70	L=0
	NX=1
	I=0
80	L=L+1
	TYPE 90
90	FORMAT(' TYPE FILE NAME ',$)
	ACCEPT 30,NW
	IF(NW.EQ.' ')GO TO 130
	IF(LOOKF(NW))GO TO 110
	TYPE 100
	GO TO 80
100	FORMAT(' FILE NOT FOUND'/)
110	I=I+1
	IP(L)=NX
	NMS(I)=NW
	CALL RDSAV(JP,NMX,K,NW,MCLEF(NX),-2)
	NX=NX+K
	IF(L.LT.10)GO TO 80
120	FORMAT(' WRITE OVER ',A5,'.DMD?  Y OR N?  ',$)
130	NX=NX-1
140	CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
	L=NX
	RETURN

150	TYPE 160,ID
160	FORMAT(' FILE FULL -- SAVED AS ',A5)
	L=1
	NM=ID
	NX=MCLEF(1)
	GO TO 130

170	CALL RDSAV(IP,NMS,NX,NM,NF,-1)
180	FORMAT(1X,A5)
	TYPE 190
190	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
	ACCEPT 30,ID
	IF(ID.EQ.' ')GO TO 10
	JD=0
	L=0
CC      NX=NX-1
	DO 200 K=1,10
	IF(NMS(K).EQ.ID)JD=K
	IF(NMS(K).EQ.' ')GO TO 210
	L=K
200	IF(JD.EQ.0.AND.K.EQ.10)GO TO 150
210	IF(N.EQ.'Z')GO TO 250
C  FOR DELETIONS
	L=L+1
	IF(JD.NE.0)GO TO 260
C ADDS ON TO END
	N=0
	IP(L)=NX+1
	DO 220 K=NX+1,MCLEF(1)+NX
	N=N+1
220	NF(K)=MCLEF(N)
	NX=NX+N
	NMS(L)=ID
	L=L+1
230	DO 240 K=1,NX
240	MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
	GO TO 140

250	MCLEF(1)=0
260	N=IP(JD)
	NR=MCLEF(1)
	M=NF(IP(JD))
	NW=NR-M
	NX=NX+NW
	IF(NW)270,310,280
270	JA=N+NR
	JB=NX
	JC=1
	GO TO 290
280	JA=NX
	JB=N+NW
	JC=-1
290	DO 300 K=JA,JB,JC
300	NF(K)=NF(K-NW)
	IF(NR.EQ.0)GO TO 340
310	DO 320 K=1,NR
	NF(N)=MCLEF(K)
320	N=N+1
CC      L=L-1
	IF(NW.EQ.0)GO TO 230
	DO 330 K=JD+1,L
330	IP(K)=IP(K)+NW
C  FIXES UP FIRST LINE.
CC123   L=L-1
CC      NX=NX-1
	GO TO 230
340	IP(L+1)=0
CC      L=L-1
	DO 350 K=JD,L-1
	IP(K)=IP(K+1)+NW
350	NMS(K)=NMS(K+1)
	NMS(L)=' '
	GO TO 230
	END

	SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
C  POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
	COMMON /RC/MCLEF(400),IST(4000)/FL/IC,NH,NQ,A,B,C,D
	DIMENSION KT(1),NMS(1),IO(1),JALL(21)
	IF(L)GO TO 20
C  L=-1  FOR READER, -2=NO TYPE OF NAME LIST.
	DO 10 N=1,10
	JALL(N)=KT(N)
10	JALL(N+11)=NMS(N)
	JALL(11)=K
	TYPE 30,K
	CALL PUTFIL(NAME)
	CALL FASTOU(JALL,21)
	CALL FASTOU(IO,K+1)
	CALL FINFIL
	RETURN

20	CALL GETFIL(NAME)
	CALL FASTIN(JALL,21)
	K=JALL(11)
	TYPE 30,K
30	FORMAT(' TOTAL WDS=',I3,'/350')
	CALL FASTIN(IO,K)
	DO 40 N=1,10
	KT(N)=JALL(N)
40	NMS(N)=JALL(N+11)
	IF(L.EQ.-2)RETURN
	TYPE 50
	TYPE 60,(NMS(N),N=1,10)
50	FORMAT(
	1'  0      1      2      3      4      5      6      7
	2      8      9')
60	FORMAT(' IDENT. NAMES:'/,10(2XA5))
	END

	SUBROUTINE CNVT
	COMMON/RC/A(4400)
	DIMENSION J(10),NM(10),M(600),JALL(21)
	EQUIVALENCE(J,JALL,A),(NX,JALL(11)),(NM,JALL(12)),(M,A(2000))
C  POINTER LIST, TOTAL WD CNT, NAME LIST.
	TYPE 10
10	FORMAT(' TYPE OLD NAME --  '$)
	ACCEPT 20,N
20	FORMAT(A5)
	TYPE 30
30	FORMAT(' NEW NAME --  '$)
	ACCEPT 20,NN
	CALL IFILE(1,N)
	NX=1
	READ(1,40)K,J
40	FORMAT(12I)
50	READ(1,40,END=70)K,K,(M(L),L=NX,NX+K-1)
	REREAD 60,L,NM
	IF(NM(1))GO TO 70
	NX=NX+K
	GO TO 50
60	FORMAT(I,10A5)

70	NX=NX-1
	CALL RDSAV(J,NM,NX,NN,M,0)
C  POINTERS, NAMES, WDCNT, FILE NAME, ARRAY, 0=WRITE
	CALL EXIT
	END